home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / COMM.SWG / 0002_Useful Serial I-O.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  16.0 KB  |  539 lines
  1. { Unit UART - serielle I/O v3    07/91,08/92,01/93 }
  2. { by Peter Mandrella, P.Mandrella@HOT.gun.de       }
  3. { Dieser Quelltext ist Public Domain.              }
  4.  
  5. {$B-,R-,S-,V-,F-,I-,A+}
  6.  
  7. unit uart;
  8.  
  9. {---------------------------------------------------------------------------)
  10.    Zu benutzende Schnittstellen sind zuerst mit SetUart zu initialisieren.
  11.    Anschlie▀end k÷nnen sie mit ActivateCom aktiviert und mit ReleaseCom
  12.    wieder freigegeben werden. Beim Aktivieren ist die Gr÷▀e des COM-Puffers
  13.    anzugeben; werden mehr als BufferSize Bytes empfangen und nicht abgeholt,
  14.    dann wird der Puffer komplett gel÷scht und der Inhalt geht verloren!
  15.    Das Desaktivieren ist nicht unbedingt n÷tig, sondern erfolgt falls
  16.    n÷tig auch automatisch bei Programmende.
  17.  
  18.    Das Empfangen von Daten erfolgt asynchron im Hintergrund. Mit Receive
  19.    k÷nnen empfangene Daten abgeholt werden. Die Funktion liefert FALSE,
  20.    falls keine Daten vorhanden waren. Wahlweise kann auch mit Received
  21.    getestet werden, ob Daten anliegen, ohne diese zu lesen, oder mit
  22.    Peek ein Byte - falls vorhanden - abgeholt, aber nicht aus dem Puffer
  23.    entfernt werden.
  24.  
  25.    Das Senden von Daten erfolgt mit SendByte (ohne CTS-Handshake) oder
  26.    mit HSendByte (mit CTS-Handshake).
  27.  
  28.    ▄ber die Funktionen RRing und Carrier kann getestet werden, ob ein
  29.    Klingelzeichen bzw. ein Carrier am Modem anliegt.
  30.  
  31.    Da fⁿr COM3 und COM4 kein Default-IRQ existiert, k÷nnen mit SetComParams
  32.    Adresse und IRQ einzelner Schnittstellen eingestellt werden. Vor dieser
  33.    Einstellung werden COM3 und COM4 nicht unterstⁿtzt. Default-Adressen
  34.    sind $3e8 und $2e8. Die Parameter von COM1 und COM2 sind korrekt
  35.    eingestellt und sollten normalerweise nicht geΣndert werden.
  36.  
  37. (---------------------------------------------------------------------------}
  38.  
  39.  
  40. interface
  41.  
  42. uses dos;
  43.  
  44. {$IFNDEF DPMI}
  45.   const Seg0040 = $40;
  46. {$ENDIF}
  47.  
  48. const  coms       = 4;     { Anzahl der unterstⁿtzten Schnittstellen }
  49.  
  50.        ua         : array[1..coms] of word = ($3f8,$2f8,$3e8,$2e8);
  51.        datainout  = 0;     { UART-Register-Offsets }
  52.        intenable  = 1;
  53.        intids     = 2;     { Read  }
  54.        fifoctrl   = 2;     { Write }
  55.        linectrl   = 3;
  56.        modemctrl  = 4;
  57.        linestat   = 5;
  58.        modemstat  = 6;
  59.        scratch    = 7;
  60.  
  61.        UartNone   = 0;     { Ergebnisse von ComType }
  62.        Uart8250   = 1;
  63.        Uart16450  = 2;
  64.        Uart16550  = 3;
  65.        Uart16550A = 4;
  66.  
  67.        NoFifo     = $00;   { Triggerlevel bei 16550-Chips }
  68.        FifoTL1    = $07;
  69.        FifoTL4    = $47;
  70.        FifoTL8    = $87;
  71.        FifoTL14   = $C7;
  72.  
  73. type   paritype   = (Pnone,Podd,Pxxxx,Peven);   { m÷gliche ParitΣts-Typen }
  74.  
  75.  
  76. { Parameter fⁿr Schnittstelle einstellen
  77. { no       : Nummer  (1-4)
  78.   address  : I/O-Adresse, 0 -> Adresse wird beibehalten
  79.   _irq     : Interrupt-Nummer  (z.B. 3 fⁿr IRQ3, 4 fⁿr IRQ4); 0..15 }
  80.  
  81. procedure SetComParams(no:byte; address:word; _irq:byte);
  82.  
  83. { Schnittstellen-Parameter einstellen
  84.   commno   : Nummer der Schnittstelle (1-4)
  85.   baudrate : Baudrate im Klartext; auch nicht-Standard-Baudraten m÷glich!
  86.   parity   : s.o.
  87.   wlength  : Wort-lΣnge (7 oder 8)
  88.   stops    : Stop-Bits (1 oder 2)   }
  89.  
  90. function ComType(no:byte):byte;     { Typ des UART-Chips ermitteln }
  91.  
  92. procedure SetUart(comno:byte; baudrate:longint; parity:paritype;
  93.                   wlength,stops:byte);
  94.  
  95. { Schnittstelle aktivieren
  96.   no         : Nummer der Schnittstelle
  97.   buffersize : Gr÷▀e des Puffers
  98.   FifoTL     : Falls ein 16550 vorhanden ist, kann man hier die Konstanten
  99.                fⁿr den Triggerlevel einsetzen (s.o.)}
  100.  
  101. procedure ActivateCom(no:byte; buffersize:word; FifoTL:Byte);
  102.  
  103. procedure ReleaseCom(no:byte);            { Schnitte desakt., Puffer freig. }
  104.  
  105. function  receive(no:byte; var b:byte):boolean;   { Byte holen, falls vorh. }
  106. function  peek(no:byte; var b:byte):boolean; {dito, aber Byte bleibt im Puffer}
  107. function  received(no:byte):boolean;      { Testen, ob Daten vorhanden }
  108. procedure flushinput(no:byte);            { Receive-Puffer l÷schen }
  109. procedure SendByte(no,b:byte);            { Byte senden }
  110. procedure hsendbyte(no,b:byte);           { Byte senden, mit CTS-Handshake }
  111. procedure putbyte(no,b:byte);             { Byte im Puffer hinterlegen }
  112.  
  113. function  rring(no:byte):boolean;         { Telefon klingelt  }
  114. function  carrier(no:byte):boolean;       { Carrier vorhanden }
  115. function  getCTS(no:byte):boolean;        { True = (cts=1)    }
  116. procedure DropDtr(no:byte);               { DTR=0 setzen      }
  117. procedure SetDtr(no:byte);                { DTR=1 setzen      }
  118. procedure DropRts(no:byte);               { RTS=0 setzen      }
  119. procedure SetRts(no:byte);                { RTS=1 setzen      }
  120. procedure SendBreak(no:byte);             { Break-Signal      }
  121.  
  122.  
  123. implementation  {-----------------------------------------------------}
  124.  
  125. const  active     : array[1..coms] of boolean = (false,false,false,false);
  126.        irq        : array[1..coms] of byte = ($04,$03,0,0);
  127.        intmask    : array[1..coms] of byte = ($10,$08,0,0);
  128.        intcom2    : array[1..coms] of boolean = (false,false,false,false);
  129.  
  130.        MS_CTS     = $10;       { Modem-Status-Register }
  131.        MS_DSR     = $20;
  132.        MS_RI      = $40;       { Ring Indicator: Klingelsignal }
  133.        MS_DCD     = $80;       { Data Carrier Detect           }
  134.        MC_DTR     = $01;       { Modem Control Register }
  135.        MC_RTS     = $02;
  136.  
  137. type   bufft      = array[0..65534] of byte;
  138.  
  139. var    savecom    : array[1..coms] of pointer;
  140.        exitsave   : pointer;
  141.        bufsize    : array[1..coms] of word;
  142.        buffer     : array[1..coms] of ^bufft;
  143.        bufi,bufo  : array[1..coms] of word;
  144.  
  145.  
  146. procedure error(text:string);
  147. begin
  148.   writeln('UART Fehler: ',text);
  149. end;
  150.  
  151. function strs(l:longint):string;
  152. var s : string;
  153. begin
  154.   str(l,s);
  155.   strs:=s;
  156. end;
  157.  
  158.  
  159. {--- Interrupt-Handler -----------------------------------------------}
  160.  
  161. procedure cli; inline($fa);            { Interrupts sperren   }
  162. procedure sti; inline($fb);            { Interrupts freigeben }
  163.  
  164. procedure com1server; interrupt;
  165. begin
  166.   if intcom2[1] then port[$a0]:=$20;
  167.   port[$20]:=$20;                      { Interrupt-Controller resetten }
  168.   buffer[1]^[bufi[1]]:=port[ua[1]];
  169.   inc(bufi[1]); if bufi[1]=bufsize[1] then bufi[1]:=0;
  170. end;
  171.  
  172. procedure com2server; interrupt;
  173. begin
  174.   if intcom2[2] then port[$a0]:=$20;
  175.   port[$20]:=$20;
  176.   buffer[2]^[bufi[2]]:=port[ua[2]];
  177.   inc(bufi[2]); if bufi[2]=bufsize[2] then bufi[2]:=0;
  178. end;
  179.  
  180. procedure com3server; interrupt;
  181. begin
  182.   if intcom2[3] then port[$a0]:=$20;
  183.   port[$20]:=$20;
  184.   buffer[3]^[bufi[3]]:=port[ua[3]];
  185.   inc(bufi[3]); if bufi[3]=bufsize[3] then bufi[3]:=0;
  186. end;
  187.  
  188. procedure com4server; interrupt;
  189. begin
  190.   if intcom2[4] then port[$a0]:=$20;
  191.   port[$20]:=$20;
  192.   buffer[4]^[bufi[4]]:=port[ua[4]];
  193.   inc(bufi[4]); if bufi[4]=bufsize[4] then bufi[4]:=0;
  194. end;
  195.  
  196. procedure com1FIFOserver; interrupt;
  197. begin
  198.   if port[ua[1]+intids] and 4<>0 then
  199.     repeat
  200.       buffer[1]^[bufi[1]]:=port[ua[1]];
  201.       inc(bufi[1]); if bufi[1]=bufsize[1] then bufi[1]:=0;
  202.     until not odd(port[ua[1]+linestat]);
  203.   if intcom2[1] then port[$a0]:=$20;
  204.   port[$20]:=$20;                      { Interrupt-Controller resetten }
  205. end;
  206.  
  207. procedure com2FIFOserver; interrupt;
  208. begin
  209.   if port[ua[2]+intids] and 4<>0 then
  210.     repeat
  211.       buffer[2]^[bufi[2]]:=port[ua[2]];
  212.       inc(bufi[2]); if bufi[2]=bufsize[2] then bufi[2]:=0;
  213.     until not odd(port[ua[2]+linestat]);
  214.   if intcom2[2] then port[$a0]:=$20;
  215.   port[$20]:=$20;
  216. end;
  217.  
  218. procedure com3FIFOserver; interrupt;
  219. begin
  220.   if port[ua[3]+intids] and 4<>0 then
  221.     repeat
  222.       buffer[3]^[bufi[3]]:=port[ua[3]];
  223.       inc(bufi[3]); if bufi[3]=bufsize[3] then bufi[3]:=0;
  224.     until not odd(port[ua[3]+linestat]);
  225.   if intcom2[3] then port[$a0]:=$20;
  226.   port[$20]:=$20;
  227. end;
  228.  
  229. procedure com4FIFOserver; interrupt;
  230. begin
  231.   if port[ua[4]+intids] and 4<>0 then
  232.     repeat
  233.       buffer[4]^[bufi[4]]:=port[ua[4]];
  234.       inc(bufi[4]); if bufi[4]=bufsize[4] then bufi[4]:=0;
  235.     until not odd(port[ua[4]+linestat]);
  236.   if intcom2[4] then port[$a0]:=$20;
  237.   port[$20]:=$20;
  238. end;
  239.  
  240.  
  241. {--- UART-Typ ermitteln ----------------------------------------------}
  242.  
  243. { Hinweis: Die Erkennung des 16550A funktioniert nur bei Chips,  }
  244. {          die weitgehend kompatibel zum Original-16550A von NS  }
  245. {          sind. Das gilt allerdings fⁿr die meisten verwendeten }
  246. {          16500A's - ich schΣtze, fⁿr ca. 97-99%                }
  247.  
  248. function ComType(no:byte):byte;     { Typ des UART-Chips ermitteln }
  249. var uart        : word;
  250.     lsave,ssave : byte;
  251.     isave,iir   : byte;
  252. begin
  253.   uart:=ua[no];
  254.   lsave:=port[uart+linectrl];
  255.   port[uart+linectrl]:=lsave xor $ff;
  256.   if port[uart+linectrl]<>lsave xor $ff then
  257.     ComType:=UartNone
  258.   else begin
  259.     port[uart+linectrl]:=lsave;
  260.     ssave:=port[uart+scratch];
  261.     port[uart+scratch]:=$5a;
  262.     if port[uart+scratch]<>$5a then
  263.       ComType:=Uart8250                 { kein Scratchpad vorhanden }
  264.     else begin
  265.       port[uart+scratch]:=$a5;
  266.       if port[uart+scratch]<>$a5 then
  267.         ComType:=Uart8250               { kein Scratchpad vorhanden }
  268.       else begin
  269.         isave:=port[uart+intids];
  270.         port[uart+fifoctrl]:=1;
  271.         iir:=port[uart+intids];
  272.         if isave and $80=0 then port[uart+fifoctrl]:=0;
  273.         if iir and $40<>0 then ComType:=Uart16550A
  274.         else if iir and $80<>0 then ComType:=Uart16550
  275.         else ComType:=Uart16450;
  276.         end;
  277.       end;
  278.     port[uart+scratch]:=ssave;
  279.     end;
  280. end;
  281.  
  282.  
  283. {--- Schnitte einstellen / aktivieren / freigeben --------------------}
  284.  
  285. procedure SetComParams(no:byte; address:word; _irq:byte);
  286. begin
  287.   if (no>=1) and (no<=coms) then begin
  288.     if address<>0 then ua[no]:=address;
  289.     irq[no]:=_irq;
  290.     intmask[no]:=(1 shl (_irq and 7));
  291.     intcom2[no]:=(_irq>7);      { 2. Interrupt-Controller }
  292.     end;
  293. end;
  294.  
  295. procedure setuart(comno:byte; baudrate:longint; parity:paritype;
  296.                   wlength,stops:byte);
  297. var uart : word;
  298. begin
  299.   uart:=ua[comno];
  300.   port[uart+linectrl]:=$80;
  301.   port[uart+datainout]:=lo(word(115200 div baudrate));
  302.   port[uart+datainout+1]:=hi(word(115200 div baudrate));
  303.   port[uart+linectrl]:= (wlength-5) or (stops-1)*4 or ord(parity)*8;
  304.   port[uart+modemctrl]:=$0b;
  305.   if port[uart+datainout]<>0 then;      { dummy }
  306. end;
  307.  
  308.  
  309. procedure clearstatus(no:byte);
  310. begin
  311.   if port[ua[no]+datainout]<>0 then;               { dummy-Read }
  312.   if port[ua[no]+linestat]<>0 then;
  313.   if port[ua[no]+modemstat]<>0 then;
  314.   if intcom2[no] then port[$a0]:=$20;
  315.   port[$20]:=$20;
  316. end;
  317.  
  318.  
  319. function IntNr(no:byte):byte;
  320. begin
  321.   if irq[no]<8 then IntNr:=irq[no]+8
  322.   else IntNr:=irq[no]+$68;
  323. end;
  324.  
  325. procedure ActivateCom(no:byte; buffersize:word; FifoTL:Byte);
  326. var p : pointer;
  327.     i : byte;
  328. begin
  329.   if active[no] then begin
  330.     error('Schnittstelle '+strs(no)+' bereits aktiviert!');
  331.     exit;
  332.     end
  333.   else if (no<1) or (no>coms) or (irq[no]=0) then
  334.     error('Schnittstelle '+strs(no)+' (noch) nicht unterstⁿtzt!')
  335.   else
  336.     active[no]:=true;
  337.  
  338.   bufsize[no]:=buffersize;                 { Puffer anlegen }
  339.   getmem(buffer[no],buffersize);
  340.   bufi[no]:=0; bufo[no]:=0;
  341.   fillchar(buffer[no]^,bufsize[no],0);
  342.  
  343.   IF (fifotl > 0)
  344.     THEN BEGIN
  345.            Port[(ua[no] + fifoctrl)] := fifotl;
  346.            IF ((Port[(ua[no] + intids)] AND $40) = 0)
  347.              THEN BEGIN
  348.                     Port[(ua[no] + fifoctrl)] := 0;
  349.                     fifotl := NoFifo;
  350.                   END;
  351.          END;
  352.  
  353.   IF (fifotl > 0)
  354.     THEN CASE no OF
  355.            1 : p:=@com1FIFOserver;
  356.            2 : p:=@com2FIFOserver;
  357.            3 : p:=@com3FIFOserver;
  358.            4 : p:=@com4FIFOserver;
  359.          END {CASE}
  360.     ELSE CASE no OF
  361.            1 : p:=@com1server;
  362.            2 : p:=@com2server;
  363.            3 : p:=@com3server;
  364.            4 : p:=@com4server;
  365.          END; {CASE}
  366.  
  367.   getintvec(IntNr(no),savecom[no]);           { IRQ setzen }
  368.   setintvec(IntNr(no),p);
  369.   port[ua[no]+intenable]:=$01;                     { Int. bei Empfang }
  370.   if intcom2[no] then
  371.     port[$a1]:=port[$a1] and (not intmask[no])     { Ints freigeben }
  372.   else
  373.     port[$21]:=port[$21] and (not intmask[no]);
  374.   clearstatus(no);
  375. end;
  376.  
  377.  
  378. procedure releasecom(no:byte);
  379. begin
  380.   if not active[no] then
  381.     error('Schnittstelle '+strs(no)+' nicht aktiv!')
  382.   else begin
  383.     active[no]:=false;
  384.     port[ua[no]+intenable]:=0;
  385.     if intcom2[no] then
  386.       port[$a1]:=port[$a1] or intmask[no]    { Controller: COMn-Ints sperren }
  387.     else
  388.       port[$21]:=port[$21] or intmask[no];
  389.     port[ua[no]+fifoctrl]:=0;
  390.     setintvec(IntNr(no),savecom[no]);
  391.     clearstatus(no);
  392.     freemem(buffer[no],bufsize[no]);
  393.     end;
  394. end;
  395.  
  396.  
  397. { Exit-Prozedur }
  398.  
  399. {$F+}
  400. procedure comexit;
  401. var i : byte;
  402. begin
  403.   for i:=1 to coms do
  404.     if active[i] then begin
  405.       DropDtr(i);
  406.       releasecom(i);
  407.       end;
  408.   exitproc:=exitsave;
  409. end;
  410. {$F-}
  411.  
  412.  
  413. {--- Daten senden / empfangen ----------------------------------------}
  414.  
  415. function received(no:byte):boolean;      { Testen, ob Daten vorhanden }
  416. begin
  417.   received:=(bufi[no]<>bufo[no]);
  418. end;
  419.  
  420.  
  421. function receive(no:byte; var b:byte):boolean;   { Byte holen, falls vorh. }
  422. begin
  423.   if bufi[no]=bufo[no] then
  424.     receive:=false
  425.   else begin
  426.     b:=buffer[no]^[bufo[no]];
  427.     inc(bufo[no]);
  428.     if bufo[no]=bufsize[no] then bufo[no]:=0;
  429.     receive:=true;
  430.     end;
  431. end;
  432.  
  433. function peek(no:byte; var b:byte):boolean;
  434. begin
  435.   if bufi[no]=bufo[no] then
  436.     peek:=false
  437.   else begin
  438.     b:=buffer[no]^[bufo[no]];
  439.     peek:=true;
  440.     end;
  441. end;
  442.  
  443. procedure sendbyte(no,b:byte);              { Byte senden }
  444. begin
  445.   while (port[ua[no]+linestat] and $20) = 0 do;
  446.   port[ua[no]]:=b;
  447. end;
  448.  
  449. procedure hsendbyte(no,b:byte);           { Byte senden, mit CTS-Handshake }
  450. begin
  451.   while (port[ua[no]+modemstat] and $10) = 0 do;
  452.   while (port[ua[no]+linestat] and $20) = 0 do;
  453.   port[ua[no]]:=b;
  454. end;
  455.  
  456. procedure putbyte(no,b:byte);             { Byte im Puffer hinterlegen }
  457. begin
  458.   if bufo[no]=0 then bufo[no]:=bufsize[no]
  459.   else dec(bufo[no]);
  460.   buffer[no]^[bufo[no]]:=b;
  461. end;
  462.  
  463. procedure flushinput(no:byte);            { Receive-Puffer l÷schen }
  464. begin
  465.   bufo[no]:=bufi[no];
  466. end;
  467.  
  468.  
  469. {--- Modem-Status-Lines ----------------------------------------------}
  470.  
  471. function rring(no:byte):boolean;            { Telefon klingelt  }
  472. begin
  473.   rring:=(port[ua[no]+modemstat] and MS_RI)<>0;
  474. end;
  475.  
  476. function carrier(no:byte):boolean;          { Carrier vorhanden }
  477. begin
  478.   carrier:=(port[ua[no]+modemstat] and MS_DCD)<>0;
  479. end;
  480.  
  481. procedure DropDtr(no:byte);                 { DTR=0 setzen      }
  482. begin
  483.   port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] and (not MC_DTR);
  484. end;
  485.  
  486. procedure SetDtr(no:byte);                  { DTR=1 setzen      }
  487. begin
  488.   port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] or MC_DTR;
  489. end;
  490.  
  491. procedure DropRts(no:byte);                 { RTS=0 setzen      }
  492. begin
  493.   port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] and (not MC_RTS);
  494. end;
  495.  
  496. procedure SetRts(no:byte);                  { RTS=1 setzen      }
  497. begin
  498.   port[ua[no]+modemctrl]:=port[ua[no]+modemctrl] or MC_RTS;
  499. end;
  500.  
  501.  
  502. { True -> Modem (oder entsprechendes GerΣt)  ist bereit, Daten zu empfangen }
  503.  
  504. function GetCTS(no:byte):boolean;
  505. begin
  506.   getcts:=((port[ua[no]+modemstat] and $10)<>0) and
  507.            ((port[ua[no]+linestat] and $20)<>0);
  508. end;
  509.  
  510.  
  511. function ticker:longint;
  512. begin
  513.   ticker:=meml[Seg0040:$6c];
  514. end;
  515.  
  516. procedure SendBreak(no:byte);             { Break-Signal      }
  517. var teiler : word;
  518.     btime  : longint;
  519.     t0     : longint;
  520. begin
  521.   CLI;
  522.   port[ua[no]+linectrl]:=port[ua[no]+linectrl] or $80;
  523.   teiler:=port[ua[no]] + 256*port[ua[no]+1];
  524.   port[ua[no]+linectrl]:=port[ua[no]+linectrl] and $7f;
  525.   STI;
  526.   btime:=teiler DIV 200;
  527.   IF (btime<1) THEN btime:=1;
  528.   t0:=ticker;
  529.   inc(btime,ticker);
  530.   Port[ua[no]+linectrl]:=port[ua[no]+linectrl] or $40;   { set break }
  531.   repeat
  532.   until (ticker>btime) or (ticker<t0);
  533.   Port[ua[no]+linectrl]:=port[ua[no]+linectrl] and $bf;  { clear break }
  534. end;
  535.  
  536. begin
  537.   exitsave:=exitproc;
  538.   exitproc:=@comexit;
  539. end.